This memo describes initial data analysis done to identify clusters in the United States where a significant portion of homes are “underwater”, a decade after the sharp decline in home prices during the global financial crisis.
An underwater home is one where the estimated value of a home is lower than the estimated principal balance of the mortgage (negative loan to value or LTV).
The analysis also seeks to identify demographic and economic features shared by communities with high rates of negative LTV homes, and to understand how negative LTV rates have changed since 2009, when some communities had a majority of homes with negative LTVs.
Code to set up workspace for data work. Expand if you want to see it.
# Turn off scientific notation
options(scipen=9999)
## Load packages
# For general data science goodness
library(tidyverse)
# For data cleaning
library(janitor)
# For working with datetime
library(lubridate)
# For reading in Excel files
library(readxl)
# For working with ZIP Codes
library(zipcode)
# For mapping
library(maps)
library(mapview)
library(sf)
library(leaflet)
library(leafpop)
library(leafem)
library(raster)
library(tigris)
# For pulling census data
library(tidycensus)
# For data.world data
library(data.world)
# For correlations
library(corrr)
library(moderndive)
library(Hmisc)
library(broom)
# For graphics
library(scales)
library(ggthemes)
library(DT)
library(ggpubr)
# Function to flatten correlation matrix
flattenCorrMatrix <- function(cormat, pmat) {
ut <- upper.tri(cormat)
data.frame(
row = rownames(cormat)[row(cormat)[ut]],
column = rownames(cormat)[col(cormat)[ut]],
cor =(cormat)[ut],
p = pmat[ut]
)
}
We used several data sets describing underwater rates, real estate metrics, and community demographic and income factors in this analysis.
We have two data negative equity via the real estate analytics firm CoreLogic: Negative equity share of all homes by county by month-year from 2009 to present and negative equity share of all homes by ZIP code in 2019. Note: We are waiting for a third data set, which they sent to us, but had errors I identified (only had data for four states), of negative equity share of all homes by ZIP code by month-year from 2009-present.
We pulled select racial, ethnic origin and economic variables from the U.S. Census American Community Survey, via the Tidycensus package.
From the real estate data firm Zillow, we pulled information on current, historical and forecast community home values. Zillow has also done extensive work on underwater homes, but stopped releasing data in 2017.
The USDA classifies county on a scale from 1 (most urban) to 9 (most rural). Unemployment via BLS in 2018.
# County rural urban code designation from USDA
# Spectrum from 1 (most urban) to 9 (most rural)
rural_urban <- read_xls("../data/input_data/rural_urban_codes/ruralurbancodes2013.xls") %>%
rename(fips_code = FIPS)
# Unemployment by county from BLS 2018
unemployment <- read_xlsx("../data/input_data/bls/laucnty18.xlsx") %>%
mutate(fips_code = paste0(state_fips,county_fips)) %>%
dplyr::select(fips_code, county_state, unemployment_rate_2018 = unemployment_rate)
Put together CoreLogic county/ZIP code level underwater data with U.S. census data, USDA ruralness data, Zillow data.
## Make county data frames (2009-2019 time series)
# Underwater data, census data, rural data - 2446 counties
underwater_county_year_no_zillow <- underwater_county_year %>%
ungroup() %>%
inner_join(rural_urban) %>%
dplyr::select(-State,-Population_2010, -County_Name, -Description) %>%
inner_join(acs_data_county, by=c("fips_code" = "geoid")) %>%
dplyr::select(fips_code, state_name = state_name.x, county_name, starts_with("RUCC"), starts_with("pct"), starts_with("median")) %>%
inner_join(unemployment) %>%
dplyr::select(-county_state)
## Joining, by = "fips_code"
## Joining, by = "fips_code"
# Underwater data, census data, rural data, Zillow data - 1477 counties
underwater_county_year_yes_zillow <- underwater_county_year_no_zillow %>%
inner_join(county_summary_forecast) %>%
dplyr::select(-RegionName, -State)
## Joining, by = "fips_code"
## Make ZIP Code dataframes (2019 only)
# Underwater data, census data - 28989 zip codes
underwater_zips_2019_no_zillow <- underwater_zips_2019 %>%
ungroup() %>%
inner_join(acs_data_zcta, by=c("zip_code" = "geoid")) %>%
dplyr::select(zip_code, everything(),-name)
# Underwater data, census data, Zillow data - 13729 zip codes
underwater_zips_2019_yes_zillow <- underwater_zips_2019_no_zillow %>%
inner_join(zip_summary_forecast) %>%
dplyr::select(-State)
## Joining, by = "zip_code"
rm(list=setdiff(ls(), c("underwater_zips_2019_no_zillow", "underwater_zips_2019_yes_zillow", "underwater_county_year_no_zillow", "underwater_county_year_yes_zillow", "flattenCorrMatrix", "negative_equity_summary_county", "negative_equity_summary_zip")))
#ZCTAs can take several minutes to download. To cache the data and avoid re-downloading in future R sessions, set `options(tigris_use_cache = TRUE)`
options(tigris_use_cache = TRUE)
# ZIP Code Points
data(zipcode)
# ZCTA shapefiles
zctas <- zctas(cb=TRUE)
# Counties
counties <- counties(cb = TRUE)
Though negative equity rates are nowhere near 2009 levels, the analysis identified 10 clusters with a higher negative equity rates relative to the rest of the country.
In the map below, click on the two-letter buttons at right to zoom to that cluster.
Click on each ZIP code to see info about each county.
Clusters * MD1 | Maryland+DC | Cluster of ZIP Codes in Prince George’s County and Anacostia in D.C. and down through Waldorm, in Charles County. * MD2 | Maryland Eastern Shore | Huge chunks of the lower Eastern Shore, through Salisbury and Ocean City. * NJ1 | South New Jersey | Large swaths of southern New Jersey, including Atlantic City, Philly suburbs. * NJ2 | North Jersey+NYC | New York City suburbs, including Newark, Elizabeth, Paterson, parts of Queens * CT | Connecticut | Several areas, including Hartford and Waterbury, Bridgeport and New Haven, up to Rhode Island border. * IA | Iowa | a bunch of communities in Iowa with no real clusters. Can’t make heads or tails of this. * FL | Florida | Worst issues in Miami, Hialeah and Homestead, scatterd parts of the state. * IL | Chicago | Huge issues surrounding Chicago, especially on South Side * CA | California | Issues in Fresno, south of Monterey, scattered throughout. * NV | Las Vegas | * No buttons, but interesting | Baton Rouge, New Orleans, Atlanta, North Dakota
# Filter for only high negative equity zip codes
high_negative_equity_zips <- underwater_zips_2019_no_zillow %>%
filter(percent_negative_equity >= 5)
# Join zip code coordinates to negative equity by zipcode
high_negative_equity_zips_geo <- geo_join(zctas, high_negative_equity_zips, 'GEOID10', 'zip_code',
how = "inner")
# Color Scheme
binpal <- colorBin("plasma", high_negative_equity_zips_geo$percent_negative_equity, 5, pretty = FALSE)
# Draw map
leaflet(high_negative_equity_zips_geo) %>%
addProviderTiles(providers$CartoDB.Positron) %>%
#addProviderTiles(providers$Wikimedia) %>%
addPolygons(fillColor = ~binpal(percent_negative_equity), weight = 1, smoothFactor = 0.5, opacity = 0.1, fillOpacity = 0.5, color="black", popup = popupTable(high_negative_equity_zips_geo)) %>%
setView(-95, 39.335359608681216, 4) %>%
addHomeButton(extent(-98.39355468750001, -89.60449218750001, 39.85072092501597, 43.8899753738369), "IA") %>%
addHomeButton(extent(-115.44021606445314, -114.89089965820314, 36.04521273039952, 36.318998009207924), "NV") %>%
addHomeButton(extent(-127.24365234375001, -109.66552734375001, 31.98944183792288, 40.713955826286046), "CA") %>%
addHomeButton(extent(-88.33145141601564, -87.23281860351564, 41.466399253078876, 41.97276436226528), "IL") %>%
addHomeButton(extent(-80.82092285156251, -79.72229003906251, 25.517657429994035, 26.12831612064242), "FL") %>%
addHomeButton(extent(-73.95446777343751, -71.75720214843751, 41.03793062246529, 42.05337156043361), "CT") %>%
addHomeButton(extent(-74.46807861328126, -73.91876220703126, 40.57484790030712, 40.83199550584334), "NJ2") %>%
addHomeButton(extent(-75.86883544921876, -73.67156982421876, 39.16414104768742, 40.20824570152502), "NJ1") %>%
addHomeButton(extent(-76.95098876953126, -74.75372314453126, 38.10214399750345, 39.16201148082406), "MD2") %>%
addHomeButton(extent(-77.1947479248047, -76.6454315185547, 38.791021386961596, 39.0549177529185), "MD1") %>%
addHomeButton(extent(-131.74804687500003, -61.43554687500001, 18.812717856407776, 52.908902047770255 ), "U.S.") %>%
addLegend("bottomleft",
pal = colorBin("plasma", high_negative_equity_zips_geo$percent_negative_equity),
values = high_negative_equity_zips_geo$percent_negative_equity,
title = "% Homes Negative Equity 2019",
labFormat = labelFormat(prefix = ""),
opacity = 1
) %>%
addEasyButton(easyButton(
states = list(
easyButtonState(
stateName="unfrozen-markers",
icon="ion-toggle",
title="Get Bounding box",
onClick = JS("
function(btn, map) {
alert(
map.getBounds().getWest() + ', ' + map.getBounds().getEast() + ', ' + map.getBounds().getSouth() + ', ' + map.getBounds().getNorth()
);
}")
)
)
)
)
datatable(high_negative_equity_zips, class = 'cell-border stripe', filter = 'top', rownames = FALSE, caption = htmltools::tags$caption(
style = 'caption-side: top; text-align: left;',
'2019: ZIP codes with negative equity >= 4%'
),
options = list(scrollX=TRUE, scrollCollapse=TRUE)
)
This map shows county-level averages. There were 89 counties with a negative equity rate above 4 percent in 2019.
# Filter for 2019
high_negative_equity_county_2019 <- underwater_county_year_no_zillow %>%
#dplyr::select(state_code, fips_code, state_name, county_name, y2019) %>%
filter(pct_negative_equity_y2019 >= 4) %>%
arrange(desc(pct_negative_equity_y2019))
# Join zip code coordinates to negative equity by zipcode
high_negative_equity_county_2019_geo <- geo_join(counties, high_negative_equity_county_2019, 'GEOID', 'fips_code',
how = "inner")
# Color Scheme
binpal <- colorBin("plasma", high_negative_equity_county_2019$pct_negative_equity_y2019, 5, pretty = FALSE)
# Draw map
leaflet(high_negative_equity_county_2019_geo) %>%
addProviderTiles(providers$CartoDB.Positron) %>%
#addProviderTiles(providers$Wikimedia) %>%
addPolygons(fillColor = ~binpal(pct_negative_equity_y2019), weight = 1, smoothFactor = 0.5, opacity = 0.1, fillOpacity = 0.5, color="black", popup = popupTable(high_negative_equity_county_2019_geo)) %>%
setView(-95, 39.335359608681216, 4) %>%
addHomeButton(extent(-98.39355468750001, -89.60449218750001, 39.85072092501597, 43.8899753738369), "IA") %>%
addHomeButton(extent(-115.44021606445314, -114.89089965820314, 36.04521273039952, 36.318998009207924), "NV") %>%
addHomeButton(extent(-127.24365234375001, -109.66552734375001, 31.98944183792288, 40.713955826286046), "CA") %>%
addHomeButton(extent(-88.33145141601564, -87.23281860351564, 41.466399253078876, 41.97276436226528), "IL") %>%
addHomeButton(extent(-80.82092285156251, -79.72229003906251, 25.517657429994035, 26.12831612064242), "FL") %>%
addHomeButton(extent(-73.95446777343751, -71.75720214843751, 41.03793062246529, 42.05337156043361), "CT") %>%
addHomeButton(extent(-74.46807861328126, -73.91876220703126, 40.57484790030712, 40.83199550584334), "NJ2") %>%
addHomeButton(extent(-75.86883544921876, -73.67156982421876, 39.16414104768742, 40.20824570152502), "NJ1") %>%
addHomeButton(extent(-76.95098876953126, -74.75372314453126, 38.10214399750345, 39.16201148082406), "MD2") %>%
addHomeButton(extent(-77.1947479248047, -76.6454315185547, 38.791021386961596, 39.0549177529185), "MD1") %>%
addHomeButton(extent(-131.74804687500003, -61.43554687500001, 18.812717856407776, 52.908902047770255 ), "U.S.") %>%
addLegend("bottomleft",
pal = binpal,
values = high_negative_equity_county_2019_geo$pct_negative_equity_y2019,
title = "% Homes Negative Equity 2019",
labFormat = labelFormat(prefix = ""),
opacity = 1
) %>%
addEasyButton(easyButton(
states = list(
easyButtonState(
stateName="unfrozen-markers",
icon="ion-toggle",
title="Get Bounding box",
onClick = JS("
function(btn, map) {
alert(
map.getBounds().getWest() + ', ' + map.getBounds().getEast() + ', ' + map.getBounds().getSouth() + ', ' + map.getBounds().getNorth()
);
}")
)
)
)
)
datatable(high_negative_equity_county_2019, class = 'cell-border stripe', filter = 'top', rownames = FALSE, caption = htmltools::tags$caption(
style = 'caption-side: top; text-align: left;',
'2019: Counties with negative equity >= 4%'
),
options = list(scrollX=TRUE, scrollCollapse=TRUE)
)
By comparison, this is every county in the U.S. in 2009 with a negative equity rate above 4 percent, 654 counties. That’s about 25 percent of counties. The problem was much more widespread following the financial crisis.
# Filter for 2009
high_negative_equity_county_2009 <- underwater_county_year_no_zillow %>%
#dplyr::select(state_code, fips_code, state_name, county_name, y2009) %>%
filter(pct_negative_equity_y2009 >= 4) %>%
arrange(desc(pct_negative_equity_y2009))
# Join zip code coordinates to negative equity by zipcode
high_negative_equity_county_2009_geo <- geo_join(counties, high_negative_equity_county_2009, 'GEOID', 'fips_code',
how = "inner")
# Color Scheme
binpal <- colorBin("plasma", high_negative_equity_county_2009_geo$pct_negative_equity_y2009, 5, pretty = FALSE)
# Draw map
leaflet(high_negative_equity_county_2009_geo) %>%
addProviderTiles(providers$CartoDB.Positron) %>%
#addProviderTiles(providers$Wikimedia) %>%
addPolygons(fillColor = ~binpal(pct_negative_equity_y2009), weight = 1, smoothFactor = 0.5, opacity = 0.1, fillOpacity = 0.5, color="black", popup = popupTable(high_negative_equity_county_2009_geo)) %>%
setView(-95, 39.335359608681216, 4) %>%
addLegend("bottomleft",
pal = binpal,
values = high_negative_equity_county_2009_geo$pct_negative_equity_y2009,
title = "% Homes Negative Equity 2009",
labFormat = labelFormat(prefix = ""),
opacity = 1
) %>%
addEasyButton(easyButton(
states = list(
easyButtonState(
stateName="unfrozen-markers",
icon="ion-toggle",
title="Get Bounding box",
onClick = JS("
function(btn, map) {
alert(
map.getBounds().getWest() + ', ' + map.getBounds().getEast() + ', ' + map.getBounds().getSouth() + ', ' + map.getBounds().getNorth()
);
}")
)
)
)
)
datatable(high_negative_equity_county_2009, class = 'cell-border stripe', filter = 'top', rownames = FALSE, caption = htmltools::tags$caption(
style = 'caption-side: top; text-align: left;',
'2009: Counties with negative equity >= 4%'
),
options = list(scrollX=TRUE, scrollCollapse=TRUE)
)
This map shows 2009 negative equity rates in counties to shows only the top 89 counties in 2009 (the same number of counties with > 4 percent negative equity in 2019). It allows us to see which places were the most problematic in 2009.
# Filter for 2009
top_negative_equity_county_2009 <- underwater_county_year_no_zillow %>%
#dplyr::select(state_code, fips_code, state_name, county_name, y2009) %>%
arrange(desc(pct_negative_equity_y2009)) %>%
head(n=89)
# Join zip code coordinates to negative equity by zipcode
top_negative_equity_county_2009_geo <- geo_join(counties, top_negative_equity_county_2009, 'GEOID', 'fips_code',
how = "inner")
# Color Scheme
binpal <- colorBin("plasma", top_negative_equity_county_2009_geo$pct_negative_equity_y2009, 5, pretty = FALSE)
# Draw map
leaflet(top_negative_equity_county_2009_geo) %>%
addProviderTiles(providers$CartoDB.Positron) %>%
#addProviderTiles(providers$Wikimedia) %>%
addPolygons(fillColor = ~binpal(pct_negative_equity_y2009), weight = 1, smoothFactor = 0.5, opacity = 0.1, fillOpacity = 0.5, color="black", popup = popupTable(high_negative_equity_county_2009_geo)) %>%
setView(-95, 39.335359608681216, 4) %>%
addLegend("bottomleft",
pal = binpal,
values =top_negative_equity_county_2009_geo$pct_negative_equity_y2009,
title = "% Homes Negative Equity 2009",
labFormat = labelFormat(prefix = ""),
opacity = 1
) %>%
addEasyButton(easyButton(
states = list(
easyButtonState(
stateName="unfrozen-markers",
icon="ion-toggle",
title="Get Bounding box",
onClick = JS("
function(btn, map) {
alert(
map.getBounds().getWest() + ', ' + map.getBounds().getEast() + ', ' + map.getBounds().getSouth() + ', ' + map.getBounds().getNorth()
);
}")
)
)
)
)
datatable(top_negative_equity_county_2009, class = 'cell-border stripe', filter = 'top', rownames = FALSE, caption = htmltools::tags$caption(
style = 'caption-side: top; text-align: left;',
'2009: 89 Counties with highest negative equity rates'
),
options = list(scrollX=TRUE, scrollCollapse=TRUE)
)
There’s not a lot of crossover. Only 13 counties on the list of the highest negative equity counties in 2009 were also there in 2019, including two Maryland counties.
on_both <- top_negative_equity_county_2009 %>%
inner_join(high_negative_equity_county_2019, by=c("fips_code", "county_name", "state_name", "pct_negative_equity_y2009", "pct_negative_equity_y2019")) %>%
dplyr::select(fips_code, county_name, state_name, pct_negative_equity_y2009, pct_negative_equity_y2019)
datatable(on_both, class = 'cell-border stripe', filter = 'top', rownames = FALSE, caption = htmltools::tags$caption(
style = 'caption-side: top; text-align: left;',
'County with highest rates in 2019 and 2009'
),
options = list(scrollX=TRUE,scrollY=TRUE, scrollCollapse=TRUE, pageLength = 13)
)
In the average and median U.S. county, underwater rates nowhere near as high as they used to be in the years immediately following the crash of the housing market. In 2009, the average U.S. county had 5.5 percent of homes with negative equity, compared to 1.52 percent today. The median showed a less dramatic decline. The 2009 mean is skewed up by some extremely high rates in select counties in 2009.
x <- underwater_county_year_no_zillow %>%
pivot_longer(cols=c("pct_negative_equity_y2009", "pct_negative_equity_y2010", "pct_negative_equity_y2011", "pct_negative_equity_y2012","pct_negative_equity_y2013","pct_negative_equity_y2014","pct_negative_equity_y2015","pct_negative_equity_y2016","pct_negative_equity_y2017","pct_negative_equity_y2018","pct_negative_equity_y2019"), names_to = "year", values_to = "percent_negative_equity") %>%
group_by(year) %>%
filter(!is.na(percent_negative_equity)) %>%
summarise(mean_percent_negative_equity = round(mean(percent_negative_equity),2),
median_percent_negative_equity = round(median(percent_negative_equity),2)
)
datatable(x, class = 'cell-border stripe', filter = 'top', rownames = FALSE, caption = htmltools::tags$caption(
style = 'caption-side: top; text-align: left;',
'Mean and median negative equity county rates by year 2009 and 2019'
),
options = list(scrollX=TRUE,scrollY=TRUE, scrollCollapse=TRUE, pageLength = 11)
)
In general, amongst the highest negative equity zips, there’s a general trend. The higher the rate of af american and hispanics, the higher the rate.
# Average table
underwater_zips_2019_no_zillow %>%
mutate(negative_equity_group = case_when(percent_negative_equity > 4 ~ "greater than 4",
TRUE ~ "less than 4")
) %>%
filter(!is.na(pct_black_2017), !is.na(median_household_income_2017)) %>%
group_by(negative_equity_group) %>%
summarise(pct_black_2017 = round(mean(pct_black_2017),2),
pct_white_2017 = round(mean(pct_white_2017),2),
pct_hispanic_2017 = round(mean(pct_hispanic_2017),2),
median_household_income_2017 = round(mean(median_household_income_2017),2)) %>%
datatable(class = 'cell-border stripe', filter = 'top', rownames = FALSE, caption = htmltools::tags$caption(
style = 'caption-side: top; text-align: left;',
'Averages'
),
options = list(scrollX=TRUE,scrollY=TRUE, scrollCollapse=TRUE, pageLength = 11)
)
We also see a fairly stark difference in the negative equity rate in majority minority ZIP codes, compared with majority white ZIP codes.
# Average table
underwater_zips_2019_no_zillow %>%
mutate(population_makeup= case_when(pct_white_2017 > 50 ~ "majority white",
TRUE ~ "majority minority")
) %>%
filter(!is.na(percent_negative_equity)) %>%
group_by(population_makeup) %>%
summarise(percent_negative_equity = round(mean(percent_negative_equity),2))
And amongst higher negative equity ZIP codes (>= 4%), we see significant trends towards higher rates of negative equity as ZIP codes’ in more African-American and Hispanic areas.
# Correlation for higher rate counties
underwater_zips_2019_no_zillow_trimmed <- underwater_zips_2019_no_zillow %>%
dplyr::select(-zip_code,-state_name,-county_name) %>%
filter(percent_negative_equity >=4)
# Create correlation matrix
underwater_zips_2019_no_zillow_correlation_matrix <- rcorr(as.matrix(underwater_zips_2019_no_zillow_trimmed))
# Flatten correlation table, to only include significant predictors p < .05
underwater_zips_2019_no_zillow_correlation_matrix <- flattenCorrMatrix(underwater_zips_2019_no_zillow_correlation_matrix$r, underwater_zips_2019_no_zillow_correlation_matrix$P) %>%
mutate(absolute_cor = abs(cor)) %>%
filter(row == "percent_negative_equity") %>%
filter(p < .05) %>%
arrange(desc(absolute_cor)) %>%
dplyr::select(-absolute_cor)
# Print correlation matrix. Let's us see both r (correlation coefficient) and p value for each predictor on an individual level
underwater_zips_2019_no_zillow_correlation_matrix %>%
filter(str_detect(column,"white|black|hispanic")) %>%
datatable()
There is correlation coefficient of .33 between an areas’ percentage of African-Americans’ and its negative equity rate, a moderate positive relationship. This is not causal, per se, just that a third of the variance in negative equity rates is explained by an areas’ concentration of African Americans. Areas with higher rates of African-Americans tend to have higher negative equity rates.
ggscatter(underwater_zips_2019_no_zillow_trimmed, x="percent_negative_equity",y= "pct_black_2017", add="loess", add.params = list(color = "blue", fill = "lightgray"), conf.int=TRUE) +
stat_cor(method = "pearson", label.x =15, label.y = 15)
There is correlation coefficient of .30 between an areas’ percentage of Hispanics and its negative equity rate, a moderate positive relationship. This is not causal, per se, just that a third of the variance in negative equity rates is explained by an areas’ concentration of African Americans. Areas with higher rates of Hispanics tend to have higher negative equity rates.
ggscatter(underwater_zips_2019_no_zillow_trimmed, x="percent_negative_equity",y= "pct_hispanic_2017", add="loess", add.params = list(color = "blue", fill = "lightgray"), conf.int=TRUE) +
stat_cor(method = "pearson", label.x = 16, label.y = 15)
As one might expect, the opposite is true for whiter areas. There is correlation coefficient of -.4 between an areas’ percentage of whites and its negative equity rate, a moderate negative relationship. This is not causal, per se, just that a two-fifths of the variance in negative equity rates is explained by an areas’ concentration of whites. Areas with higher rates of whites tend to have higher lower negative equity rates.
ggscatter(underwater_zips_2019_no_zillow_trimmed, x="percent_negative_equity",y= "pct_white_2017", add="loess", add.params = list(color = "blue", fill = "lightgray"), conf.int=TRUE) +
stat_cor(method = "pearson", label.x = 16, label.y = 15)
The analysis identified target ZIP codes where reporting could be focused that are emblematic of the larger trend towards higher rates of negative equity in minority neighborhoods.
For majority black neighborhoods, this includes:
* 11208 in Brooklyn, a majority black neighborhood with 26% negative equity; * 07062 (in Plainfield), 07108 (Newark), 07114 (Newark). These north New Jersey neighborhoods all have greater than 16% negative equity. * A cluster of nine ZIP codes in Chicago with greater than 15% negative equity; * A ton more examples, if you look at the table below, which are all majority black neighborhoods, including many Maryland ZIPs
high_negative_equity_zips %>%
filter(pct_black_2017 > 50) %>%
datatable(class = 'cell-border stripe', filter = 'top', rownames = FALSE, caption = htmltools::tags$caption(
style = 'caption-side: top; text-align: left;',
'2019: majority black ZIP codes with negative equity >= 4%'
),
options = list(scrollX=TRUE, scrollCollapse=TRUE)
)
At the county level, several areas with large African-American populations have high negative equity rates, including: * Five Maryland counties/city: Prince George’s, Baltimore (city), Charles, Somerset and Dorchester * Seven counties/cities in Virginia. * More in the table below.
high_negative_equity_county_2019 %>%
dplyr::select(state_name, county_name, pct_negative_equity_y2019, pct_white_2017, pct_black_2017, pct_hispanic_2017) %>%
arrange(desc(pct_black_2017)) %>%
datatable(class = 'cell-border stripe', filter = 'top', rownames = FALSE, caption = htmltools::tags$caption(
style = 'caption-side: top; text-align: left;',
'2019: Counties with negative equity >= 4%'
),
options = list(scrollX=TRUE, scrollCollapse=TRUE)
)
For majority Hispanic neighborhoods, this includes:
* A cluster of five ZIP codes in Chicago with greater than 14% negative equity; * Two neighborhoods in Connecticut (06608, 06114) * Two neighborhoods in Fresno, California (93606, 93702) * Many more examples in the table below, including several Maryland ZIPs.
high_negative_equity_zips %>%
filter(pct_hispanic_2017 > 50) %>%
datatable(class = 'cell-border stripe', filter = 'top', rownames = FALSE, caption = htmltools::tags$caption(
style = 'caption-side: top; text-align: left;',
'2019: majority Hispanic ZIP codes with negative equity >= 4%'
),
options = list(scrollX=TRUE, scrollCollapse=TRUE)
)
At the county level, this includes places with large Hispanic populations, including: * Miami-Dade in Florida * Several counties in California and New Jersey
high_negative_equity_county_2019 %>%
dplyr::select(state_name, county_name, pct_negative_equity_y2019, pct_white_2017, pct_black_2017, pct_hispanic_2017) %>%
arrange(desc(pct_hispanic_2017)) %>%
datatable(class = 'cell-border stripe', filter = 'top', rownames = FALSE, caption = htmltools::tags$caption(
style = 'caption-side: top; text-align: left;',
'2019: Counties with negative equity >= 4%'
),
options = list(scrollX=TRUE, scrollCollapse=TRUE)
)
This is not to say that only majority-minority neighborhods are affected. There are hundreds of examples of overwhelmingly white neighborhoods (greater than 90% white) with high rates, including parts of Connecticut, Arizona, Iowa, New Jersey, Maryland and others. See the table below.
high_negative_equity_zips %>%
filter(pct_white_2017 > 90) %>%
datatable(class = 'cell-border stripe', filter = 'top', rownames = FALSE, caption = htmltools::tags$caption(
style = 'caption-side: top; text-align: left;',
'2019: majority white (90%+) ZIP codes with negative equity >= 4%'
),
options = list(scrollX=TRUE, scrollCollapse=TRUE)
)
At the county level, places with tiny minority populations that have high negative equity rates include: * Seven Iowa counties and five Illinois counties. * Others on the table below.
high_negative_equity_county_2019 %>%
dplyr::select(state_name, county_name, pct_negative_equity_y2019, pct_white_2017, pct_black_2017, pct_hispanic_2017) %>%
arrange(desc(pct_white_2017)) %>%
datatable(class = 'cell-border stripe', filter = 'top', rownames = FALSE, caption = htmltools::tags$caption(
style = 'caption-side: top; text-align: left;',
'2019: Counties with negative equity >= 4%'
),
options = list(scrollX=TRUE, scrollCollapse=TRUE)
)
Counties with higher levels of negative equity have higher median home values, as measured by the Zillow Home Value Index (zhvi). But property values in these areas are also growing more slowly, as measured by changes in the zillow home value index from the previous month, quarter and year. They are also forecast to grow slower in the next year. This is not to say that negative equity rates caused these trends, just that there are observable differences between the two.
underwater_county_year_yes_zillow %>%
mutate(negative_equity = case_when(pct_negative_equity_y2019 >= 4 ~ "neg_equity >= 4%",
TRUE ~ "neg_equity < 4%"
)) %>%
group_by(negative_equity) %>%
summarise(zhvi = round(mean(zhvi),2),
zhvi_month_pct_change = round(mean(zhvi_month_pct_change),2),
zhvi_quarter_pct_change = round(mean(zhvi_quarter_pct_change),2),
zhvi_year_pct_change = round(mean(zhvi_year_pct_change),2),
zhvi_five_year_pct_change = round(mean(zhvi_five_year_pct_change),2),
zhvi_ten_year_pct_change = round(mean(zhvi_ten_year_pct_change),2),
zhvi_forecast_year_pct_change = round(mean(zhvi_forecast_year_pct_change),2),
) %>%
datatable(class = 'cell-border stripe', filter = 'top', rownames = FALSE, caption = htmltools::tags$caption(
style = 'caption-side: top; text-align: left;',
'2019: Counties with negative equity >= 4%'
),
options = list(scrollX=TRUE, scrollCollapse=TRUE)
)
It’s fairly easy to predict a county’s negative equity rate in 2019 based on its negative equity rate in 2018. If it was high in 2018, it was – with few exceptions – high in 2019. Things don’t change that much from year to year.
As the table below shows the correlation coefficient between negative equity rates in 2019 and 2018 was .98, which is about as strong as it gets.
But this trend diminishes over time. The relationship between negative equity rates in 2019 and the rates a decade earlier, in 2009, was only moderate (.41). Just because a county had a high negative equity rate in 2009, it’s not a guarantee that it had a high negative equity rate in 2019.
underwater_county_year_yes_zillow %>%
dplyr::select(-matches("code|state|name|county|date|region|Metro|County|City|Month|Quarter|Last|Time|Description")) %>%
correlate(method = c("pearson")) %>%
dplyr::select(-RUCC_2013, -pct_negative_equity_y2009:-pct_negative_equity_y2018, -pct_white_2017:-zhvi_forecast_year_pct_change) %>%
filter(!str_detect(rowname,"RUCC|_2017|_2018|2019|zhvi")) %>%
mutate(corr_with_pct_negative_equity_y2019 = round(pct_negative_equity_y2019, 2)) %>%
arrange(desc(rowname)) %>%
datatable(
extensions = 'FixedColumns',
options = list(
pageLength = 50,
dom = 't',
scrollX = TRUE,
fixedColumns = list(leftColumns = 2)
)
)
##
## Correlation method: 'pearson'
## Missing treated using: 'pairwise.complete.obs'
There are places that were at the epicenter of the problem in 2009 and are still there a decade later. This table normalizes the specific negative equity rates for each county by ranking them on a scale from 0 (lowest rates) to 100 (highest rates) , allowing us to more easily compare across years.
This includes: * Charles County and Prince George’s County, Maryland, which were in the top 99 percent in both 2009 and 2019. * Osceola County and Miami-Dade County, Florida, which were both in the top 97 percent in both years.
underwater_county_year_yes_zillow %>%
filter(pct_negative_equity_y2019 >= 1) %>%
ungroup() %>%
#na.omit() %>%
mutate_at(vars(contains("y20")), funs(round(percent_rank(.)*100,0))) %>%
rename_at(vars(contains("y20")), function(x) paste0(x,"_rank")) %>%
dplyr::select(-fips_code, -RUCC_2013, -pct_negative_equity_y2010_rank:-pct_negative_equity_y2018_rank, -pct_white_2017:-zhvi_forecast_year_pct_change) %>%
mutate(mean_2009_2019_negative_equity_rank = (pct_negative_equity_y2009_rank+pct_negative_equity_y2019_rank)/2) %>%
dplyr::select(state_name, county_name, mean_2009_2019_negative_equity_rank, everything()) %>%
arrange(desc(mean_2009_2019_negative_equity_rank)) %>%
datatable(
rownames = FALSE,
extensions = 'FixedColumns',
options = list(
pageLength = 50,
dom = 't',
scrollX = TRUE,
fixedColumns = list(leftColumns = 2)
)
)
There are also places that were among the worst in 2009 that now have some of the country’s lowest rates. This includes several counties in California (perhaps because home prices have appreciated so fast)? Take Alameda County, California. It’s negative equity rate was in the 90th percentile in 2009. In 2019, it was among the lowest in the U.S. (1st percentile).
underwater_county_year_yes_zillow %>%
filter(pct_negative_equity_y2019 >= 1) %>%
ungroup() %>%
#na.omit() %>%
mutate_at(vars(contains("y20")), funs(round(percent_rank(.)*100,0))) %>%
rename_at(vars(contains("y20")), function(x) paste0(x,"_rank")) %>%
dplyr::select(-fips_code, -RUCC_2013, -pct_negative_equity_y2010_rank:-pct_negative_equity_y2018_rank, -pct_white_2017:-zhvi_forecast_year_pct_change) %>%
mutate(negative_equity_rank_change_2009_2019 = (pct_negative_equity_y2009_rank-pct_negative_equity_y2019_rank)) %>%
dplyr::select(state_name, county_name, negative_equity_rank_change_2009_2019, everything()) %>%
arrange(desc(negative_equity_rank_change_2009_2019)) %>%
filter(!is.na(negative_equity_rank_change_2009_2019)) %>%
datatable(
rownames = FALSE,
extensions = 'FixedColumns',
options = list(
pageLength = 50,
dom = 't',
scrollX = TRUE,
fixedColumns = list(leftColumns = 2)
)
)
The opposite is also true. Consider a place like Woodford County, Illinois. It had one of the lowest rates of negative equity in 2009 (3rd percentile). In 2019, it’s in the 96th percentile.
underwater_county_year_yes_zillow %>%
filter(pct_negative_equity_y2019 >= 1) %>%
ungroup() %>%
#na.omit() %>%
mutate_at(vars(contains("y20")), funs(round(percent_rank(.)*100,0))) %>%
rename_at(vars(contains("y20")), function(x) paste0(x,"_rank")) %>%
dplyr::select(-fips_code, -RUCC_2013, -pct_negative_equity_y2010_rank:-pct_negative_equity_y2018_rank, -pct_white_2017:-zhvi_forecast_year_pct_change) %>%
mutate(negative_equity_rank_change_2009_2019 = (pct_negative_equity_y2009_rank-pct_negative_equity_y2019_rank)) %>%
dplyr::select(state_name, county_name, negative_equity_rank_change_2009_2019, everything()) %>%
arrange(negative_equity_rank_change_2009_2019) %>%
filter(!is.na(negative_equity_rank_change_2009_2019)) %>%
datatable(
rownames = FALSE,
extensions = 'FixedColumns',
options = list(
pageLength = 50,
dom = 't',
scrollX = TRUE,
fixedColumns = list(leftColumns = 2)
)
)
We have data from 2017 (nothing later) via Zillow that has loan to value buckets for each county and ZIP code. I’m still working on analyzing this.
negative_equity_summary_county %>%
datatable(rownames = FALSE,
extensions = 'FixedColumns',
options = list(
pageLength = 50,
dom = 't',
scrollX = TRUE,
fixedColumns = list(leftColumns = 2)))
## Warning in instance$preRenderHook(instance): It seems your data is too
## big for client-side DataTables. You may consider server-side processing:
## https://rstudio.github.io/DT/server.html
# Filter by zip
negative_equity_summary_zip %>%
datatable(rownames = FALSE,
extensions = 'FixedColumns',
options = list(
pageLength = 50,
dom = 't',
scrollX = TRUE,
fixedColumns = list(leftColumns = 2)))
## Warning in instance$preRenderHook(instance): It seems your data is too
## big for client-side DataTables. You may consider server-side processing:
## https://rstudio.github.io/DT/server.html
## Load and clean zillow data from data.world
#Strategy
#What are the ramifications of negative equity?
#Negative equity can cast a shadow over the economy, effectively prolonging an economic downturn. Just as skyrocketing home values can drive confidence and spending, negative equity can keep people home, literally. Many people who might have found jobs in other markets were tied to their homes and unable to sell because the money they would make from selling would not be enough to pay off their mortgages. Negative equity can have a number of other chilling impacts on local housing markets, disproportionately impacting minority communities and owners of lower-valued homes, exacerbating inventory shortages and increasing the likelihood of foreclosure for underwater homeowners.
# https://www.zillow.com/research/negative-equity-race-q3-2016-14063/
# https://www.zillow.com/research/q3-2016-negative-equity-report-13954/
#HOLY SHIT THERE S A FUCKING MODEL ON PAGE 14 that has everything I need. #https://www.frbatlanta.org/-/media/documents/community-development/publications/discussion-papers/2016/01-housing-negative-equity-in-sixth-federal-reserve-district-2016-03-10.pdf
#https://www.zillow.com/research/q3-2016-negative-equity-report-13954/
#But this drop, while encouraging, masks the often very wide divide that remains between the top of the market and the bottom of the market. In a number of large markets, the spread between the negative equity rate at the top and the bottom of the market is alarmingly wide. In Detroit, for example, the negative equity rate among top-tier homes is 4.4 percent; among bottom-tier homes, the negative equity rate is almost ten times higher at 39 percent – a gap of 34.6 percentage points, the largest gap among the 35 largest metros analyzed. The gap between top-tier and bottom-tier negative equity is more than 20 percentage points in an additional four large metros: Cleveland (28.1 points), St. Louis (22 points), Atlanta (21 points) and Chicago (20.5 points).